#
# pp3multitype.R
#
# Functions for handling 3D multitype point patterns
#
# $Revision: 1.0 $
#

"is.multitype.pp3" <- function(X) {
  if(!inherits(X, "pp3"))
    stop("X must be a pp3 object")
  if(!spatstat.geom::is.marked(X, dfok=FALSE))
    return(FALSE)
  marx <- spatstat.geom::marks(X)
  if(!is.factor(marx))
    return(FALSE)
  return(length(levels(marx)) > 1)
}

"pp3multitype" <- function(X, marks, ...) {
  if(!inherits(X, "pp3"))
    stop("X must be a pp3 object")

  if(missing(marks)) {
    if(spatstat.geom::is.marked(X)) {
      marx <- spatstat.geom::marks(X)
      if(!is.factor(marx))
        stop("Existing marks are not a factor - cannot create multitype pattern")
    } else {
      stop("No marks provided and pattern is unmarked")
    }
  } else {
    if(!is.factor(marks))
      marks <- as.factor(marks)
    if(length(marks) != spatstat.geom::npoints(X))
      stop("Length of marks vector must equal number of points")
    X <- X %mark% marks
  }

  if(length(levels(spatstat.geom::marks(X))) < 2)
    stop("Multitype pattern requires at least 2 mark levels")

  class(X) <- c("pp3multitype", class(X))
  return(X)
}

"print.pp3multitype" <- function(x, ...) {
  cat("Multitype 3D point pattern\n")
  NextMethod()
  marx <- marks(x)
  cat("Mark levels:", paste(levels(marx), collapse=", "), "\n")
  cat("Mark frequencies:\n")
  print(table(marx))
}

"summary.pp3multitype" <- function(object, ...) {
  result <- NextMethod()
  marx <- marks(object)
  result$marklevels <- levels(marx)
  result$markfreq <- table(marx)
  class(result) <- c("summary.pp3multitype", class(result))
  return(result)
}